home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / bbs / mfm_111b.zip / SAVEKILL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-07  |  4KB  |  134 lines
  1. {========================================================================}
  2. Function SizeOfFilesBbs(FileArea : String) : LongInt;
  3.   Var
  4.     FilesBbs : File Of Byte;
  5.     SizeOfFile : LongInt;
  6.   Begin
  7.     Assign(FilesBbs,FileArea+'FILES.BBS');
  8.     {$I-} Reset(FilesBbs); {$I+}
  9.     If IOresult = 0 Then
  10.     Begin
  11.       SizeOfFilesBbs := FileSize(FilesBbs);
  12.       Close(FilesBbs);
  13.     End
  14.     Else
  15.     Begin
  16.       SizeOfFilesBbs := 0;
  17.     End;
  18.   End;
  19. {========================================================================}
  20. Function InMainList(TempEntry : ListPtr) : Boolean;
  21.   Begin
  22.     NextPrintEntry := FirstEntry; InMainList := False;
  23.     While NextPrintEntry^.NextEntry <> NIL Do
  24.     Begin
  25.       If NextPrintEntry^.FileName = TempEntry^.FileName Then InMainList := True;
  26.       NextPrintEntry := NextPrintEntry^.NextEntry;
  27.     End;
  28.   End;
  29. {========================================================================}
  30. Procedure EraseKillList;
  31.   Var
  32.     FileToErase : File;
  33.   Begin
  34.     While KillEntry <> NIL Do
  35.     Begin
  36.       FindFirst(FileAreaPath+KillEntry^.FileName,Archive,DirInfo);
  37.       If DosError = 0 Then
  38.       Begin
  39.         If (Not InMainList(KillEntry)) Then
  40.         Begin
  41.           If UpperString(KillEntry^.FileName) <> 'FILES.BBS' Then
  42.           Begin
  43.             Assign(FileToErase,FileAreaPath+KillEntry^.FileName);
  44.             Erase(FileToErase);
  45.           End;
  46.         End;
  47.       End;
  48.       OldEntry := KillEntry;
  49.       If KillEntry^.PrevEntry = KillEntry Then
  50.       Begin
  51.         Dispose(KillEntry);
  52.         KillEntry := NIL;
  53.       End
  54.       Else
  55.       Begin
  56.         KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  57.         KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  58.         KillEntry := KillEntry^.NextEntry;
  59.       End;
  60.       If KillEntry <> NIL Then Dispose(OldEntry);
  61.     End;
  62.   End;
  63. {========================================================================}
  64. Procedure Mfm2Bbs2Bak(InString : PathStr);
  65.   Var
  66.     TmpFilVar : Text;
  67.   Begin
  68.     FindFirst(InString+'FILES.BAK',AnyFile,DirInfo);
  69.     If DosError = 0 Then
  70.     Begin
  71.       Assign(TmpFilVar,InString+'FILES.BAK');
  72.       Erase(TmpFilVar);
  73.     End;
  74.     FindFirst(InString+'FILES.BBS',AnyFile,DirInfo);
  75.     If DosError = 0 Then
  76.     Begin
  77.       Assign(TmpFilVar,InString+'FILES.BBS');
  78.       Rename(TmpFilVar,InString+'FILES.BAK');
  79.     End;
  80.     Assign(TmpFilVar,InString+'FILES.MFM');
  81.     Rename(TmpFilVar,InString+'FILES.BBS');
  82.   End;
  83. {========================================================================}
  84. Procedure SaveList;
  85.   Var
  86.     Slc : Char;
  87.   Begin
  88.     AnsiGotoXY(25,1); AnsiClearToEOL;
  89.     Write('This will DELETE killed files and update FILES.BBS, Are you sure? ');
  90.     Repeat
  91.       Gbx := GetInput;
  92.       Slc := Upcase(Chr(Gbx));
  93.     Until Slc In ['N','Y'];
  94.     Write(Slc);
  95.     If Slc = 'Y' Then
  96.     Begin
  97.       Assign(FileList,FileAreaPath+'FILES.MFM');
  98.       {$I-} ReWrite(FileList); {$I+}
  99.       If IOresult = 0 Then
  100.       Begin
  101.         NextPrintEntry := FirstEntry;
  102.         While NextPrintEntry^.NextEntry <> NIL Do
  103.         Begin
  104.           If NextPrintEntry^.TypeOfRecord <> Orphan Then
  105.           Begin
  106.             If NextPrintEntry^.TypeOfRecord <> Comment Then
  107.             Begin
  108.               Write(FileList,NextPrintEntry^.FileName);
  109.               Write(FileList,Copy('         ',1,13-Length(NextPrintEntry^.FileName))+' ');
  110.             End;
  111.             WriteLn(FileList,NextPrintEntry^.Description);
  112.           End;
  113.           NextPrintEntry := NextPrintEntry^.NextEntry;
  114.         End;
  115.         If NextPrintEntry^.TypeOfRecord <> Orphan Then
  116.         Begin
  117.           Write(FileList,NextPrintEntry^.FileName);
  118.           Write(FileList,' ');
  119.           WriteLn(FileList,NextPrintEntry^.Description);
  120.         End;
  121.         Close(FileList);
  122.         Mfm2Bbs2Bak(FileAreaPath);
  123.         EraseKillList;
  124.         AnsiGotoXY(25,1); AnsiClearToEOL;
  125.       End;
  126.       ChooseAreaEntry^.Changed := True;
  127.       AreaChanged := True;
  128.       Altered := False;
  129.     End
  130.     Else Write('N');
  131.     AnsiGotoXY(24,80);
  132.   End;
  133. {========================================================================}
  134.